perm filename VERIFY.SAI[SYS,HE] blob
sn#128412 filedate 1974-11-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00018 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 ifc declaration(distst)≠check_type(define) thenc
C00006 00003 COMMENT VERIFY - the verification message procedure (variables)
C00010 00004 α VERIFY cont. (TEST1, SCAN)
C00020 00005 α VERIFY cont. (SCANSET, HSTGRM, COLWHEEL)
C00022 00006 α VERIFY cont. (CNTRST, FINECALL)
C00024 00007 α VERIFY cont. (DPYSHW)
C00026 00008 α VERIFY con. (DPYSHW)
C00027 00009 α VERIFY cont. (TSIG-line significance function)
C00033 00010 α VERIFY cont. (COLINT - chooses color filter for best contrast)
C00036 00011 α VERIFY - start of body - initialize
C00038 00012 α VERIFY body cont. - main loop
C00042 00013 α VERIFY body cont. - return results
C00044 00014 message procedure to set parameters
C00046 00015 SETCOR - for main program debugging mode
C00048 00016 SERCOR - main loop
C00050 00017 main program starts here
C00052 00018 main program continues
C00054 ENDMK
C⊗;
ifc declaration(distst)≠check_type(define) thenc
BEGIN "VERIFY" COMMENT THIS IS THE EDGE AND LINE VERIFIER;
DEFINE DISTST="TRUE"; COMMENT controls compilation of display code;
DEFINE MAIN="TRUE"; COMMENT defines this as a main program;
REQUIRE -1 NEW_ITEMS;
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "HELIB[1,3]" LIBRARY;
ifc distst thenc
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
endc
STRING JOB, FILE;
DEFINE CALL_JOB="JOB",
THIS_JOB="""VERIFY""",
DEB_JOB="DEB_VER",
TYP_JOB="TYP_VER";
elsec DEFINE MAIN="FALSE"; endc
ifc distst thenc
EXTERNAL PROCEDURE FADCHG(REAL X,Y;PROCEDURE F);
EXTERNAL PROCEDURE FRDCHG(REAL X,Y;PROCEDURE F);
ifc ¬declaration(OVERL) thenc
EXTERNAL PROCEDURE OVERL(INTEGER ARRAY DPYBUF; INTEGER N, M, L, E;
BOOLEAN CHAN); endc
endc;
INTEGER SHORT L, W, DEBUG, DSK, DVID;
comment
to use this with another program, define DISTST either true or false
(TRUE if you want display capabilities) before requiring this file
the requiring program must require PREAMB.SAI and HELIB
(and DPYSUB.HDR[SYS,HE] if DISTST is true) and must
contain the following DEFINES:
CALL_JOB is the string variable containing the logical name of the
just calling the message procedure, for sending this return
message. If you want output to go to the console instead,
JOB←"TTY"
THIS_JOB is the logical name of the job requiring this file
DEB_JOB is the DEB_... flag in the global model for this job
TYP_JOB is the TYP_... flag in the global model for this job
GIVE_JOB is the name of the procedure which gets the result instead
of VER_RESULT if CALL_JOB=THIS_JOB
Disk input capabilites are available only if this is a main program;
COMMENT VERIFY - the verification message procedure (variables)
X1, Y1 is the coordinate of the starting point
X2, Y2 is the coordinate of the ending point
TV is the number of the camera to use
COLOR is the number of the color filter to use (0-3)
anything else for all filters
FLAG is TRUE to scan entire space between points,
FALSE to scan until two successive failures found
returns message procedure VER_RESULT with integer array
argument RESULT[0:N,0:2] where N is the number of
tests, RESULT[i,0],RESULT[i,1] is the coordinate of
the point on (X1,Y1)-(X2,Y2) about which the test
was made, RESULT[i,2] is the test result (boolean)
RESULT[0,0] contains N, RESULT[0,1] contains the
number of successful tests, RESULT[0,2] contains
the % of sucessful tests ;
MESSAGE PROCEDURE VERIFY(INTEGER X1, Y1, X2, Y2, TV, COLOR;
BOOLEAN FLAG);
BEGIN "VERIF"
SHORT INTEGER P1X, P2X, P1Y, P2Y, W2, CLP1, CLP2, RIG, BOT,
REACNT, CNT, N, T, I, X, Y, XX, YY, FRA;
SHORT REAL XINC, YINC, REA, QNOISE, TX, TY, LW, LNM, A, B, C, D,
AV1, AV2, OFFSET, DI, OFFSAVE, OFFH, SHFT;
EXTERNAL SHORT INTEGER BCLIP, TCLIP, STVFL, IND, TVCAM, TVWORD,
FLINE, LLINE, RSIDE, LSIDE;
SAFE SHORT INTEGER ARRAY VALUES[1:L*W*2];
SAFE OWN SHORT INTEGER ARRAY HISTO[0:16];
BOOLEAN OUTSID, DEBUGX, COLFLG, OK;
EXTERNAL PROCEDURE SENSINIT(BOOLEAN FLAG);
EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY FOO);
EXTERNAL PROCEDURE TVIN;
EXTERNAL PROCEDURE ACC(BOOLEAN PROCEDURE T;BOOLEAN F;INTEGER C,M);
EXTERNAL PROCEDURE INTPNT;
EXTERNAL INTEGER PROCEDURE GETPNT(INTEGER X,Y);
EXTERNAL INTEGER PROCEDURE DDACO(INTEGER DAC);
EXTERNAL PROCEDURE CWHEEL(INTEGER I);
REQUIRE "⊂⊃||" DELIMITERS;
DEFINE CRLF=⊂'15&'12⊃, TTEST=⊂3.087⊃, α=⊂COMMENT⊃,
IFTYPE=⊂IF TYP_JOB THEN ⊃, LENG=⊂4⊃, WIDTH=⊂2⊃;
α LENG AND WIDTH CONTROL OPERATOR SIZE AND SHAPE
(UNLESS CHANGED IN DEBUGGING MODE)
WIDTH IS THE NUMBER OF POINTS PERPENDICULAR TO THE EDGE
LENG IS THE NUMBER OF POINTS PARALLEL TO THE EDGE
LENG=1, WIDTH=5 IS THE PURE EDGE OPERATOR
LENG=5, WIDTH=1 IS THE PURE LINE OPERATOR;
α VERIFY cont. (TEST1, SCAN);
PRELOAD_WITH [8] 0;
SAFE SHORT OWN REAL ARRAY CONVLT[0:3,1:2];
α CONTRAST AND TARGET FOR 4 COLOR FILTERS
0-RED,1-BLUE,2-GREEN,3-WHITE;
α accomodation test routine ;
SIMPLE BOOLEAN PROCEDURE TEST1(REFERENCE INTEGER I1,I2);
BEGIN
IF ¬STVFL THEN TVIN;
I1 ← GETPNT(X, Y);
I2 ← GETPNT(XX, YY);
RETURN(ABS(I1-I2)≥11);
END;
α return X,Y coordinates of point in rectangle given by:
TX,TY is coordinate of point on line
OFFSET is offset from line
DI is index from offset
I,J are indicies in rectangle (0≤I≤L-1, 0≤J≤W-1)
OUTSID set TRUE if point outside buffer, not changed otherwise;
SIMPLE PROCEDURE SCAN(SHORT REAL DI; SHORT INTEGER I, J);
BEGIN
SHORT REAL IND;
IND ← OFFSET+DI+(IF DI>0 THEN J ELSE -J);
X ← TX+D*IND+C*I-A+.5;
Y ← TY-C*IND+D*I-B+.5;
IF ¬(0≤X≤RIG∧0≤Y≤BOT) THEN
BEGIN "SCANA"
OUTSID ← TRUE;
OUTSTR("POINT OUTSIDE BUFFER - VERIFY"&CRLF);
END "SCANA";
END;
α VERIFY cont. (SCANSET, HSTGRM, COLWHEEL) ;
α set up constants for scanning the operator;
PROCEDURE SCANSET;
BEGIN SHORT REAL TF;
A ← P2Y-P1Y;
B ← P2X-P1X;
TF ← SQRT(A↑2+B↑2);
C ← B/TF;
D ← A/TF;
N ← TF/L;
IF N>15.0∧FLAG THEN N←15.0;
XINC ← B/N;
YINC ← A/N;
IF N<4 THEN BEGIN N←N*2; XINC←XINC/2; YINC←YINC/2; END;
A ← C*L/2.0;
B ← D*L/2.0;
W2 ← W%2;
IF W2<1 THEN W2←1;
END;
α calculate histogram for current half of window;
SIMPLE PROCEDURE HSTGRM;
BEGIN "HSTG"
SHORT INTEGER I, INTN, J;
FOR I←0 STEP 1 UNTIL 16 DO HISTO[I]←0;
FOR I←L-1 STEP -1 UNTIL 0 DO
FOR J←W-1 STEP -1 UNTIL 0 DO
BEGIN
SCAN(DI,I,J);
IF OUTSID THEN RETURN;
INTN←GETPNT(X,Y);
HISTO[INTN]←HISTO[INTN]+1;
END;
FOR I←0 STEP 1 UNTIL 15 DO HISTO[16]←HISTO[16]+HISTO[I];
END "HSTG";
α change color filter;
SIMPLE PROCEDURE COLWHEEL(INTEGER I);
IF COLFILT_ACC≠I THEN
BEGIN INTEGER N;
CWHEEL(COLFILT_ACC←I);
N←20000 ;
WHILE N>0 DO N←N-1;
END ;
α VERIFY cont. (CNTRST, FINECALL) ;
α computes contrast achieved under present accomodation;
SIMPLE REAL PROCEDURE CNTRST;
BEGIN "CNTR"
SHORT INTEGER I, J;
SHORT REAL AVG1,AVG2;
IF ¬STVFL THEN TVIN;
OUTSID ← FALSE;
CLP1 ← CLP2 ← 0;
HSTGRM;
IF OUTSID THEN RETURN(0);
AVG1←0;
FOR I←1 STEP 1 UNTIL 15 DO AVG1←AVG1+I*HISTO[I];
AVG1←AVG1/HISTO[16];
CLP1←HISTO[0]+HISTO[15];
DI←-DI;
HSTGRM;
DI←-DI;
IF OUTSID THEN RETURN(0);
AVG2←0;
FOR I←1 STEP 1 UNTIL 15 DO AVG2←AVG2+I*HISTO[I];
AVG2←AVG2/HISTO[16];
CLP2←HISTO[0]+HISTO[15];
AVG2←AVG2-AVG1;
RETURN(ABS(AVG2));
END "CNTR";
α accomodates for maximum contrast;
SIMPLE REAL PROCEDURE FINECALL;
BEGIN
OUTSID ← FALSE;
SCAN(DI,L/2,W2);
XX ← X;
YY ← Y;
SCAN(-DI,L/2,W2);
IF OUTSID THEN RETURN(0);
ACC(TEST1,TYP_VER,0,2);
RETURN(CNTRST);
END;
α VERIFY cont. (DPYSHW) ;
α debugging display outputs points used in test and values
then waits for input - P dumps current buffer and
N terminates debugging for this call;
ifc distst thenc
PROCEDURE DPYSHW(REAL VAL1, VAL2);
BEGIN
EXTERNAL PROCEDURE PICSPL(BOOLEAN FLAG; STRING TITLE);
INTEGER I,J, K, A1, A2;
SAFE INTEGER ARRAY BUF[1:100];
GETFORMAT(A1,A2);
J ← GETPOG;
IF J<0 THEN BEGIN OUTSTR("NO FRAME"&CRLF); RETURN; END;
SETFORMAT(10,3);
DPYSET(BUF);
DPYBRT(1);
DPYBIG(2);
IF DSK THEN
BEGIN
AIVECT(P1X,P1Y);
AVECT(P1X,P2Y);
AVECT(P2X,P2Y);
AVECT(P2X,P1Y);
AVECT(P1X,P1Y);
END ELSE BEGIN
FADCHG(LSIDE,FLINE,AIVECT);
FRDCHG(RSIDE,FLINE,RVECT);
FRDCHG(RSIDE,LLINE,RVECT);
FRDCHG(LSIDE,LLINE,RVECT);
FRDCHG(LSIDE,FLINE,RVECT);
END;
FOR I←L-1 STEP -1 UNTIL 0
DO FOR K←W-1 STEP -1 UNTIL 0 DO
BEGIN
SCAN(DI,I,K);
IF DSK THEN APOINT(X,Y) ELSE
FRDCHG(X+LSIDE,Y+FLINE,RPOINT);
SCAN(-DI,I,K);
IF DSK THEN APOINT(X,Y) ELSE
FRDCHG(X+LSIDE,Y+FLINE,RPOINT);
END;
IF DSK THEN AIVECT(10,30) ELSE FRDCHG(100,300,RIVECT);
DPYSST("V1="&CVF(VAL1)&" V2="&CVF(VAL2));
α VERIFY con. (DPYSHW);
IF ¬DSK THEN DPYOUT(J) ELSE IF DVID THEN
BEGIN
DPYPARS;
OVERL(BUF,1,1,0,2,FALSE);
END;
I ← INCHWL;
IF I="P" THEN PICSPL(TRUE,"VERIFIER DUMP");
IF I="N" THEN BEGIN DEBUGX ← FALSE; RELPOG(FRA); END;
RELPOG(J);
SETFORMAT(A1,A2);
END;
elsec
PROCEDURE DPYSHW(REAL A,B);
RETURN;
endc
α VERIFY cont. (TSIG-line significance function) ;
SIMPLE REAL PROCEDURE TSIG;
BEGIN "STT"
REAL SP, SM, SPQ, SMQ, SIGP, SIGM, I1, I2;
SHORT INTEGER I, J, K;
K ← OUTSID ← SP ← SM ← SPQ ← SMQ ← 0;
IF ¬STVFL THEN TVIN;
FOR I← L-1 STEP -1 UNTIL 0
DO FOR J←W-1 STEP -1 UNTIL 0 DO
BEGIN "STTA"
SCAN(DI,I,J);
IF OUTSID THEN RETURN(0);
K←K+1;
VALUES[K] ← I1 ← GETPNT(X,Y);
SCAN(-DI,I,J);
IF OUTSID THEN RETURN(0);
K ← K+1;
VALUES[K] ← I2 ← GETPNT(X,Y);
SP ← SP+I1;
SPQ ← SPQ+I1↑2;
SM ← SM+I2;
SMQ ← SMQ+I2↑2;
END;
AV1 ← SP/LW;
AV2 ← SM/LW;
SIGP ← (SPQ-SP↑2/LW)/LNM MAX QNOISE;
SIGM ← (SMQ-SM↑2/LW)/LNM MAX QNOISE;
IF DEBUGX THEN
BEGIN
INTEGER A,B;
GETFORMAT(A,B);
SETFORMAT(3,0);
FOR K←1 STEP 2 UNTIL LW*2 DO
OUTSTR(CVS(VALUES[K]));
OUTSTR("|||");
FOR K←2 STEP 2 UNTIL LW*2 DO
OUTSTR(CVS(VALUES[K]));
OUTSTR(CRLF);
SETFORMAT(A,B);
END;
RETURN(ABS((SP-SM)/(SQRT((SIGP+SIGM)/LW)*LW)));
END "STT";
α VERIFY cont. (COLINT - chooses color filter for best contrast) ;
SIMPLE PROCEDURE COLINT;
BEGIN "COLINT"
LABEL MX;
SHORT REAL HIAVG;
SHORT INTEGER I,IMAX, A, B;
GETFORMAT(A,B);
SETFORMAT(0,3);
DI←4.0;
TX ← P1X + XINC*N/2;
TY ← P1Y + YINC*N/2;
FOR IND←3,1,0,2 DO
BEGIN "COLCHG"
IF COLFLG∧COLOR≠IND THEN CONTINUE;
COLWHEEL(IND);
IF ¬FIL_ACC[IND]∨CHANGE_ACC THEN
BEGIN
SENSINIT(TYP_VER);
FIL_ACC[IND] ← AUTO_ACC;
END ELSE AUTO_ACC ← FIL_ACC[IND];
CONVLT[IND,1]←FINECALL;
CONVLT[IND,2]←DAC_ACC;
IFTYPE OUTSTR((CASE IND OF ("RED","BLUE","GREEN",
"CLEAR"))&"FILTER: CONTRAST="&
CVF(CONVLT[IND,1])&" DAC_ACC="&
CVF(CONVLT[IND,2])&CRLF);
IF CONVLT[IND,1]≥11.0 THEN GO TO MX;
END "COLCHG";
IF ¬COLFLG THEN
BEGIN "GETMAX"
IMAX←3;
HIAVG←CONVLT[3,1];
FOR I←2 STEP -1 UNTIL 0 DO
IF CONVLT[I,1]>HIAVG THEN
BEGIN HIAVG←CONVLT[I,1]; IMAX←I; END;
COLWHEEL(IMAX);
IF TVCAM=1 THEN
BEGIN
IF CONVLT[IMAX,2]≠DAC_ACC THEN
DDACO(CONVLT[IMAX,2]);
AUTO_ACC←FIL_ACC[IMAX];
END;
END "GETMAX";
MX: IFTYPE OUTSTR("BEST FILTER IS "&(CASE COLFILT_ACC OF
("RED","BLUE","GREEN","CLEAR")) & CRLF);
SETFORMAT(A,B);
END "COLINT";
α VERIFY - start of body - initialize;
TVCAM ← TV;
DEBUGX ← DEBUG∨DEB_JOB;
ifc ¬main thenc
L←LENG;
W ← WIDTH;
DSK ← DVID ← FALSE;
endc
LNM ← (LW ← L*W)-1;
IF ¬DSK THEN
BEGIN
FLINE ← ((Y1 MIN Y2)-20) MAX 15;
LLINE ← ((Y1 MAX Y2)+20) MIN 250;
LSIDE ← ((X1 MIN X2)-20) MAX 15;
RSIDE ← ((X1 MAX X2)+20) MIN 330;
END;
BOT ← LLINE-FLINE+1;
RIG ← RSIDE-LSIDE+1;
P1X ← X1-LSIDE;
P2X ← X2-LSIDE;
P1Y ← Y1-FLINE;
P2Y ← Y2-FLINE;
I ← IF DSK THEN 1 ELSE ((RIG DIV 9)+1)*BOT;
SCANSET;
BEGIN "INNER"
SAFE SHORT INTEGER ARRAY BUFR[0:I], RESULT[0:N,0:2];
IF ¬DSK THEN
BEGIN
TVWORD ← GIOWD(BUFR);
TVIN;
END;
INTPNT;
IF ¬DSK THEN
BEGIN
CWHEEL(6);
COLFILT_ACC ← IND;
COLFLG ← 0≤COLOR≤3;
COLINT;
END;
DI←1.5;
CNT ← OFFSET←REACNT←0;
QNOISE ← ((1+BCLIP-TCLIP)/256)↑2;
TX ← P1X+XINC;
TY ← P1Y+YINC;
OK ← TRUE;
α VERIFY body cont. - main loop;
FOR T←4 STEP 1 UNTIL N DO
BEGIN "LOOP"
LABEL L1,L2;
CNT ← CNT+1;
TX ← TX+XINC;
TY ← TY+YINC;
REA←TSIG;
IF DEBUGX THEN DPYSHW(REA,OFFSET);
SHFT ← 0;
OFFH ← OFFSAVE←OFFSET;
IF REA<TTEST THEN
BEGIN "ACO"
IF TCLIP≠BCLIP∨¬(1.≤AV1≤14.)∨¬(1.≤AV2≤14.)
THEN BEGIN
IF ¬DSK THEN FINECALL;
QNOISE ← ((1+BCLIP-TCLIP)/256)↑2;
REA ← TSIG;
IF DEBUGX THEN DPYSHW(REA,OFFSET);
IF REA≥TTEST THEN GO TO L1;
END;
WHILE TRUE DO
BEGIN "SHIFT"
SHFT←IF SHFT≤0 THEN ABS(SHFT)+1.0 ELSE -SHFT;
OFFSET ← OFFH+SHFT;
IF ABS(OFFSET)>5.0∨ABS(SHFT)>2.0 THEN
BEGIN
OFFSET ← OFFSAVE;
GO TO L2;
END;
REA ← TSIG;
IF DEBUGX THEN DPYSHW(REA,OFFSET);
IF REA≥TTEST THEN
BEGIN
OFFSAVE ← OFFSET;
DONE;
END;
END "SHIFT";
END "ACO";
L1: REACNT←REACNT+1;
OK ← TRUE;
L2: OFFSET ← OFFSAVE;
I ← REA≥TTEST;
RESULT[CNT,0] ← TX+LSIDE;
RESULT[CNT,1] ← TY+FLINE;
RESULT[CNT,2] ← I;
IF ¬I THEN IF OK THEN OK←FALSE ELSE
IF ¬FLAG THEN DONE;
END "LOOP";
α VERIFY body cont. - return results;
RESULT[0,0] ← CNT;
RESULT[0,1] ← REACNT;
RESULT[0,2] ← (REACNT*100+CNT-1) DIV CNT;
IF EQU(JOB,"TTY") THEN
BEGIN "TYPE"
OUTSTR(CRLF);
IF DEBUGX THEN FOR I←1 STEP 1 UNTIL CNT DO
OUTSTR(CVS(RESULT[I,0])&","&CVS(RESULT[I,1])
&" "&(IF RESULT[I,2]
THEN "TRUE" ELSE "FALSE")&CRLF);
FOR I←0 STEP 1 UNTIL 2 DO
OUTSTR(CVS(RESULT[0,I])&" ");
OUTSTR("%"&CRLF);
END "TYPE" ELSE
ifc declaration(give_job) thenc
IF EQU(THIS_JOB,CALL_JOB) THEN GIVE_JOB(RESULT) ELSE
endc
ISSUE(5,THIS_JOB,CALL_JOB,MESSAGE VER_RESULT(RESULT));
END "INNER";
ifc distst thenc
RELPOG(FRA);
endc
END "VERIF";
ifc main thenc
REQUIRE "EDGLIB[SYS,HE]" LIBRARY;
EXTERNAL PROCEDURE PICINI(INTEGER CHAN, FILE, EXT, PPN;
REFERENCE BOOLEAN FAIL; INTEGER ARRAY STOR);
EXTERNAL PROCEDURE PICRD(REFERENCE BOOLEAN FAIL; INTEGER ARRAY STOR);
EXTERNAL INTEGER PROCEDURE GETCOR(INTEGER SIZE);
EXTERNAL PROCEDURE RELCOR(INTEGER PNTR);
EXTERNAL BOOLEAN PROCEDURE DDVID(STRING COMMAND);
EXTERNAL SHORT INTEGER BCLIP, TCLIP, STVFL, TVWORD,FLINE,LLINE,RSIDE,LSIDE;
SHORT INTEGER XM, YM, IOWD;
DEFINE CRLF="'15&'12";
COMMENT message procedure to set parameters;
MESSAGE PROCEDURE SETPARAM(STRING FILE; INTEGER LL, WW);
BEGIN
INTEGER EXT, PPN, FAIL;
SAFE INTEGER ARRAY STOR[1:25];
IF EQU(FILE,"TV") THEN
BEGIN
DSK ← STVFL ← TRUE;
IF IOWD THEN BEGIN RELCOR(IOWD); IOWD ← 0; END;
END ELSE
IF LENGTH(FILE)>0 THEN
BEGIN
PICINI(1,CVFIL(FILE,EXT,PPN),EXT,PPN,FAIL,STOR);
IF FAIL THEN
BEGIN
OUTSTR(FILE&" DOES NOT EXIST"&CRLF);
RETURN;
END;
IF ¬STOR[1] THEN
BEGIN
OUTSTR("NO BLACK AND WHITE IMAGE EXISTS"&CRLF);
RETURN;
END;
DSK ← TRUE;
BCLIP ← TCLIP ← -1;
IF IOWD THEN RELCOR(IOWD);
IOWD ← TVWORD ← GETCOR(STOR[1]);
ARRCLR(STOR,0);
STOR[1] ← TVWORD+1;
PICRD(FAIL,STOR);
RELEASE(1);
IF BCLIP<0 THEN BEGIN BCLIP ← 7; TCLIP ← 0; END;
STVFL ← TRUE;
XM ← (LSIDE+RSIDE) DIV 2;
YM ← (FLINE+LLINE) DIV 2;
DVID ← DDVID("E;→2;↔2;F1,1;L0");
IF ¬DVID THEN OUTSTR("DDVID failed !!"&CRLF);
END;
IF LL THEN L ← LL;
IF WW THEN W ← WW;
END;
REQUIRE UNSTACK_DELIMITERS;
comment SETCOR - for main program debugging mode;
COMMENT position TV cursor by keyboard input and return left end in X,Y
←→↑↓ move cursor by Q units in selected direction
↔ alternate Q between 16 and 2
E exits from routine (returns true)
D exits from main loop (returns false)
X,Y saved in XM,YM for starting position on next call
if disk input, ← points to dot on DDVID overlay where cursor is
positioned ;
BOOLEAN PROCEDURE SETCOR(REFERENCE INTEGER X,Y);
BEGIN INTEGER I, Q;
SAFE INTEGER ARRAY BUF[1:20];
EXTERNAL PROCEDURE TVMOVE;
EXTERNAL PROCEDURE TVREAD;
EXTERNAL INTEGER PROCEDURE GIOWD(INTEGER ARRAY FOO);
EXTERNAL PROCEDURE TVIN;
Q ← 16;
IF ¬DSK THEN
BEGIN
TVWORD ← GIOWD(BUF);
FLINE ← LLINE ← YM;
RSIDE ← LSIDE ← XM;
TVMOVE;
END ELSE BEGIN
ifc distst thenc
DPYSET(BUF);
APOINT(XM-LSIDE,YM-FLINE);
DPYSST("←");
DPYPARS;
OVERL(BUF,1,1,0,2,FALSE);
endc;
END;
comment SERCOR - main loop ;
WHILE TRUE DO
BEGIN "MOVE"
WHILE TRUE DO IF ¬DSK THEN
BEGIN "LIVE"
DO TVREAD UNTIL (I←INCHRS)≥0;
IF I="←" THEN RSIDE←LSIDE←(RSIDE-Q) MAX 15 ELSE
IF I="→" THEN RSIDE←LSIDE←(RSIDE+Q) MIN 250 ELSE
IF I="↑" THEN FLINE←LLINE←(FLINE-Q) MAX 15 ELSE
IF I="↓" THEN FLINE←LLINE←(FLINE+Q) MIN 330 ELSE DONE;
TVMOVE;
END "LIVE" ELSE BEGIN "STOR"
I ← INCHRW;
IF I="←" THEN XM←(XM-Q) MAX LSIDE ELSE
IF I="→" THEN XM←(XM+Q) MIN RSIDE ELSE
IF I="↑" THEN YM←(YM-Q) MAX FLINE ELSE
IF I="↓" THEN YM←(YM+Q) MIN LLINE ELSE DONE;
ifc distst thenc
DPYSET(BUF);
APOINT(XM-LSIDE,YM-FLINE);
DPYSST("←");
DPYPARS;
OVERL(BUF,1,1,0,2,FALSE);
endc;
END "STOR";
IF I="↔" THEN Q ← IF Q=16 THEN 2 ELSE 16 ELSE
IF I="E" THEN DONE ELSE
IF I="D" THEN RETURN(FALSE);
END "MOVE";
IF ¬DSK THEN BEGIN XM ← LSIDE; YM ← FLINE; TVIN; END;
X ← XM;
Y ← YM;
RETURN(TRUE);
END;
COMMENT main program starts here;
PUT_DATA(0,0,"VERIFY");
FILE ← NULL;
YES_VER ← TRUE;
SETFORMAT(0,0);
IOWD ← 0;
XM ← 160;
YM ← 125;
L ← 4;
W ← 2;
WHILE TRUE DO
IF RUN THEN
BEGIN "MONMOD"
INTEGER MESS;
MESS ← GET_ENTRY('160,NULL,NULL,"VERIFY");
JOB ← GET_DATA(1,MESS);
QUEUE('600,MESS);
END "MONMOD" ELSE BEGIN "TTYMOD"
INTEGER COL, FLG, TV, XX, YY, X, Y, CHR, EXT, PPN, FAIL;
SAFE INTEGER ARRAY STOR[1:25];
STRING FILE;
JOB ← "TTY";
OUTSTR("DEBUG?");
DEBUG ← INCHWL="Y";
TYP_VER ← TRUE;
OUTSTR("TV= ");
CHR ← INCHWL;
IF CHR≠"D" THEN
BEGIN
DSK ← FALSE;
TV ← CHR-"0";
OUTSTR("FILTER (0=RED, 1=BLUE, 2=GREEN, 3=WHITE, -1=ALL) = ");
COL ← CVD(INCHWL);
END ELSE BEGIN "DSKIN"
DSK ← TRUE;
BCLIP ← TCLIP ← -1;
comment main program continues;
DO BEGIN
OUTSTR("FILE NAME IS: ");
FILE ← INCHWL;
PICINI(1,CVFIL(FILE,EXT,PPN),EXT,PPN,FAIL,STOR);
IF FAIL∨¬STOR[1] THEN OUTSTR("ERROR"&CRLF);
END UNTIL ¬FAIL∧STOR[1];
TVWORD ← GETCOR(STOR[1]);
ARRCLR(STOR,0);
STOR[1] ← TVWORD+1;
PICRD(FAIL,STOR);
RELEASE(1);
IF BCLIP<0 THEN BEGIN BCLIP ← 7; TCLIP ← 0; END;
STVFL ← TRUE;
XM ← (LSIDE+RSIDE) DIV 2;
YM ← (FLINE+LLINE) DIV 2;
DVID ← DDVID("E;→2;↔2;F1,1;L0");
IF ¬DVID THEN OUTSTR("DDVID failed !!"&CRLF);
END "DSKIN";
WHILE TRUE DO
BEGIN "CALL"
IF DEBUG THEN
BEGIN
OUTSTR("CHANGE OPERATOR?");
IF INCHWL="Y" THEN
BEGIN
OUTSTR("LENGTH=");
L ← CVD(INCHWL);
OUTSTR("WIDTH=");
W ← CVD(INCHWL);
END;
END;
OUTSTR("POINT 1=");
IF ¬SETCOR(X,Y) THEN DONE;
OUTSTR("POINT 2=");
IF ¬SETCOR(XX,YY) THEN DONE;
OUTSTR("WHOLE LINE?");
FLG ← INCHWL="Y";
VERIFY(X,Y,XX,YY,TV,COL,FLG);
END "CALL";
IF DSK THEN RELCOR(TVWORD);
END "TTYMOD";
END "VERIFY";
endc;